home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / print / pptable.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.3 KB  |  63 lines
  1. (* Copyright 1992 by AT&T Bell Laboratories *)
  2. (* pptable.sml *)
  3.  
  4. signature PPTABLE =
  5. sig
  6.   exception PP_NOT_INSTALLED
  7.   val pp_object : PrettyPrint.ppstream -> Stamps.stamp -> System.Unsafe.object
  8.                   -> unit
  9.   val install_pp : string list -> 
  10.                    (PrettyPrint.ppstream -> System.Unsafe.object -> unit) -> unit
  11. end
  12.  
  13. structure PPTable : PPTABLE =
  14. struct
  15.  
  16. (* The following code implements automatic prettyprinting of values. *)
  17. (* The user defines a datatype d, then defines a prettyprinter       *)
  18. (*                                                                   *)
  19. (*     dp : ppstream -> d -> unit                                    *)
  20. (*                                                                   *)
  21. (* over d, perhaps using the Oppen primitives. Then dp is installed  *)
  22. (* in the "pp table" via install_pp. Subsequently, when a value of   *)
  23. (* type d comes to be printed out, we look in the table, find dp and *)
  24. (* apply it to the value. If it is not found, we print the value in  *)
  25. (* the default manner.                                               *)
  26.  
  27.   type object = System.Unsafe.object
  28.  
  29.   exception PP_NOT_INSTALLED
  30.  
  31.   fun error msg = 
  32.         (ErrorMsg.errorNoFile (ErrorMsg.defaultConsumer(),ref false) (0,0) 
  33.                   ErrorMsg.COMPLAIN
  34.                   msg
  35.                   ErrorMsg.nullErrorBody;
  36.      raise ErrorMsg.Error)
  37.  
  38.   val global_pp_table: (PrettyPrint.ppstream->object->unit) Stamps.stampMap =
  39.       Stamps.newMap(PP_NOT_INSTALLED)
  40.  
  41.   fun make_path([s],p) = rev(Symbol.tycSymbol(s)::p)
  42.     | make_path(s::r,p) = make_path(r,Symbol.strSymbol(s)::p)
  43.     | make_path _ = error "install_pp: empty path" 
  44.  
  45.   fun install_pp (path_names: string list)
  46.                  (p: PrettyPrint.ppstream -> object -> unit) =
  47.       let val sym_path = make_path(path_names,[])
  48.       val tycon = ModuleUtil.lookTYC
  49.            (StaticEnv.atop
  50.          (#static(Environment.staticPart(!Environment.topLevelEnvRef)),
  51.           #static(Environment.staticPart(!Environment.pervasiveEnvRef))),
  52.         sym_path,
  53.         ErrorMsg.errorNoFile(ErrorMsg.defaultConsumer(),ref false) (0,0))
  54.        in case tycon
  55.         of Types.GENtyc{stamp,...} => Stamps.updateMap global_pp_table (stamp,p)
  56.          | _ => error "install_pp: nongenerative type constructor"
  57.       end
  58.  
  59.   fun pp_object ppstrm (s: Stamps.stamp) (obj:object) =
  60.       Stamps.applyMap(global_pp_table,s) ppstrm obj
  61.  
  62. end (* structure PPTABLE *)
  63.